home *** CD-ROM | disk | FTP | other *** search
/ The X-Philes (2nd Revision) / The X-Philes Number 1 (1995).iso / xphiles / hp48hor1 / echelon.src < prev    next >
Text File  |  1991-02-21  |  2KB  |  59 lines
  1. %%HP: T(3)A(D)F(.);
  2. @ ECHELON
  3. @ by Brian Korver.
  4. @ Reduces matrix to "row-reduced echelon form".
  5. @ [See RWRD on this disk for another approach.  -jkh-]
  6. \<< \-> matr
  7.   \<<
  8.     IF 'matr' VTYPE 3 == matr SIZE SIZE 1 > AND
  9.     THEN 1 1 1 matr SIZE LIST\-> DROP \-> det p q m n
  10.       \<<
  11.         WHILE 'p\<=m' \->NUM 'q\<=n' \->NUM AND
  12.         REPEAT 0 p \-> cmax k
  13.           \<< p m
  14.             FOR row matr row q 2 \->LIST GET ABS \-> x
  15.               \<<
  16.                 IF 'x>cmax'
  17.                 THEN x 'cmax' STO row 'k' STO
  18.                 END
  19.               \>>
  20.             NEXT
  21.             IF ' cmax>.00001'
  22.             THEN 1 n
  23.               FOR col matr p col 2 \->LIST GET matr k col 2 \->LIST GET
  24.                 \-> tp tk
  25.                 \<< matr k col 2 \->LIST tp PUT 'matr' STO matr p col 2
  26.                   \->LIST tk PUT 'matr' STO
  27.                 \>>
  28.               NEXT
  29.               IF 'k >p'
  30.               THEN det NEG 'det' STO
  31.               END matr p q 2 \->LIST GET \-> l
  32.               \<< 1 n
  33.                 FOR col matr p col 2 \->LIST GET l / \-> tl
  34.                   \<< matr p col 2 \->LIST tl PUT 'matr' STO
  35.                   \>>
  36.                 NEXT l det * 'det' STO
  37.               \>> 1 m
  38.               FOR row matr row q 2 \->LIST GET \-> l
  39.                 \<< 1 n
  40.                   FOR col
  41.                     IF 'row\=/p'
  42.                     THEN matr row col 2 \->LIST GET matr p col 2 \->LIST GET
  43.                       l * - \-> tv
  44.                       \<< matr row col 2 \->LIST tv PUT 'matr' STO
  45.                       \>>
  46.                     END
  47.                   NEXT
  48.                 \>>
  49.               NEXT 'p' INCR DROP 'q' INCR DROP
  50.             ELSE 0 'det' STO 'q' INCR DROP
  51.             END
  52.           \>>
  53.         END
  54.       \>> matr "Reduced Echelon Matrix\010 " 1 DISP 1 FREEZE
  55.     ELSE matr "ECHEL Error:\010Not A Matrix" 1 DISP 1400 .065 BEEP 1 FREEZE
  56.     END
  57.   \>>
  58. \>>
  59.